home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / library / help.tcl < prev    next >
Encoding:
Text File  |  1993-11-06  |  10.3 KB  |  352 lines  |  [TEXT/MPS ]
  1. #
  2. # help.tcl --
  3. #
  4. # Tcl help command. (see TclX manual)
  5. # 
  6. #------------------------------------------------------------------------------
  7. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  8. #
  9. # Permission to use, copy, modify, and distribute this software and its
  10. # documentation for any purpose and without fee is hereby granted, provided
  11. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12. # Mark Diekhans make no representations about the suitability of this
  13. # software for any purpose.  It is provided "as is" without express or
  14. # implied warranty.
  15. #------------------------------------------------------------------------------
  16. # The help facility is based on a hierarchical tree of subjects (directories)
  17. # and help pages (files).  There is a virtual root to this tree. The root
  18. # being the merger of all "help" directories found along the $auto_path
  19. # variable.
  20. #------------------------------------------------------------------------------
  21. # $Id: help.tcl,v 2.5 1993/06/24 07:30:29 markd Exp $
  22. #------------------------------------------------------------------------------
  23. #
  24.  
  25. #@package: TclX-help help helpcd helppwd apropos
  26.  
  27. #------------------------------------------------------------------------------
  28. # Return a list of help root directories.
  29.  
  30. proc help:RootDirs {} {
  31.     global auto_path
  32.     set roots {}
  33.     foreach dir $auto_path {
  34.         if [file isdirectory $dir:help] {
  35.             lappend roots $dir:help
  36.         }
  37.     }
  38.     return $roots
  39. }
  40.  
  41. #------------------------------------------------------------------------------
  42. # Take a path name which might have "." and ".." elements and flatten them out.
  43. # Also removes trailing and adjacent ":", unless its the only character.
  44.  
  45. proc help:FlattenPath pathName {
  46.     set newPath {}
  47.     foreach element [split $pathName :] {
  48.         if {[lempty $element]} continue
  49. ###     if {"$element" == "." || [lempty $element]} continue
  50.  
  51.         if {"$element" == ""} {
  52.             if {[llength [join $newPath :]] == 0} {
  53.                 error "Help: name goes above subject directory root"}
  54.             lvarpop newPath [expr [llength $newPath]-1]
  55.             continue
  56.         }
  57.         lappend newPath $element
  58.     }
  59.     set newPath [join $newPath :]
  60.  
  61.     # Take care of the case where we started with something line "/" or "/."
  62.  
  63.     if {("$newPath" == "") && [string match ":*" $pathName]} {
  64.         set newPath ":"
  65.     }
  66.         
  67.     return $newPath
  68. }
  69.  
  70. #------------------------------------------------------------------------------
  71. # Given a pathName relative to the virtual help root, convert it to a list of
  72. # real file paths.  A list is returned because the path could be "/", returning
  73. # a list of all roots. The list is returned in the same order of the auto_path
  74. # variable. If path does not start with a "/", it is take as relative to the
  75. # current help subject.  Note:  The root directory part of the name is not
  76. # flattened.  This lets other commands pick out the part relative to the
  77. # one of the root directories.
  78. proc help:ConvertPath pathName {
  79.     global TCLENV
  80.  
  81.     if {![string match ":*" $pathName]} {
  82.         if {"$TCLENV(help:curSubject)" == ":"} {
  83.             set pathName ":$pathName"
  84.         } else {
  85.             set pathName "$TCLENV(help:curSubject):$pathName"
  86.         }
  87.     }
  88.     set pathName [help:FlattenPath $pathName]
  89.  
  90.     # If the virtual root is specified, return a list of directories.
  91.  
  92.     if {$pathName == ":"} {
  93.         return [help:RootDirs]
  94.     }
  95.  
  96.     # Not the virtual root find the first match.
  97.  
  98.     foreach dir [help:RootDirs] {
  99.         if [file readable $dir:$pathName] {
  100.             return [list $dir:$pathName]
  101.         }
  102.     }
  103.     error "\"$pathName\" does not exist"
  104. }
  105.  
  106. #------------------------------------------------------------------------------
  107. # Return the virtual root relative name of the file given its absolute path.
  108. # The root part of the path should not have been flattened, as we would not
  109. # be able to match it.
  110.  
  111. proc help:RelativePath pathName {
  112.     foreach dir [help:RootDirs] {
  113.         if {[csubstr $pathName 0 [clength $dir]] == $dir} {
  114.             set name [csubstr $pathName [clength $dir] end]
  115.             if {$name == ""} {set name :}
  116.             return $name
  117.         }
  118.     }
  119.     if ![info exists found] {
  120.         error "problem translating \"$pathName\""
  121.     }
  122.  
  123. }
  124.  
  125. #------------------------------------------------------------------------------
  126. # Given a list of path names to subjects generated by ConvertPath, return
  127. # the contents of the subjects.  Two lists are returned, subjects under that
  128. # subject and a list of pages under the subject.  Both lists are returned
  129. # sorted.  This merges all the roots into a virtual root.  pathName is the
  130. # string that was passed to ConvertPath and is used for error reporting.
  131. # *.brk files are not returned.
  132.  
  133. proc help:ListSubject {pathName pathList subjectsVar pagesVar} {
  134.     upvar $subjectsVar subjects $pagesVar pages
  135.  
  136.     set subjects {}
  137.     set pages {}
  138.     set foundDir 0
  139.     foreach dir $pathList {
  140.         if ![file isdirectory $dir] continue
  141.         set foundDir 1
  142.         foreach file [glob -nocomplain $dir:*] {
  143.             if [string match *.brf $file] continue
  144.             if [file isdirectory $file] {
  145.                 lappend subjects [file tail $file]:
  146.             } else {
  147.                 lappend pages [file tail $file]
  148.             }
  149.         }
  150.     }
  151.     if !$foundDir {
  152.         error "\"$pathName\" is not a subject"
  153.     }
  154.     set subjects [lsort $subjects]
  155.     set pages [lsort $pages]
  156.     return {}
  157. }
  158.  
  159. #------------------------------------------------------------------------------
  160. # Display a line of output, pausing waiting for input before displaying if the
  161. # screen size has been reached.  Return 1 if output is to continue, return
  162. # 0 if no more should be outputed, indicated by input other than return.
  163. #
  164.  
  165. proc help:Display line {
  166.     global TCLENV
  167.     
  168.     if {([info globals MACINTOSH] == "") || \
  169.          ([info globals THINK_CONSOLE] != "")} {
  170.         if {$TCLENV(help:lineCnt) >= 23} {
  171.             set TCLENV(help:lineCnt) 0
  172.             puts stdout ":" nonewline
  173.             flush stdout
  174.             gets stdin response
  175.             if {![lempty $response]} {
  176.                 return 0
  177.             }
  178.         }
  179.     }
  180.     
  181.     puts stdout $line
  182.     incr TCLENV(help:lineCnt)
  183. }
  184.  
  185. #------------------------------------------------------------------------------
  186. # Display a help page (file).
  187.  
  188. ###
  189. ### TGE - completely re-written for the Mac.
  190. ###
  191. proc help:DisplayPage filePath {
  192.     if {[info globals TICKLE] != ""} {
  193.         open_file_window "$filePath" text
  194.     } else {
  195.         set inFH [open $filePath r]
  196.         set pagedata [read $inFH]
  197.         ###
  198.         ### This transliteration fixes the brain damaged ThinkC Console...
  199.         ###
  200.         if {[info globals THINK_CONSOLE] != ""} {
  201.             while { 1 } {
  202. if [regexp {^([^
  203. ]*)
  204. (.*)} $pagedata match sub1 pagedata] { if {![help:Display $sub1]} { break } } else {
  205.                 help:Display $pagedata
  206.                 break
  207.                 }
  208.             }
  209.         } else {
  210.             puts stdout $pagedata
  211.             close $inFH
  212.         }
  213.     }
  214. }    
  215.  
  216. #------------------------------------------------------------------------------
  217. # Display a list of file names in a column format. This use columns of 14 
  218. # characters 3 blanks.
  219.  
  220. proc help:DisplayColumns {nameList} {
  221.     set count 0
  222.     set outLine ""
  223.     foreach name $nameList {
  224.         if {$count == 0} {
  225.             append outLine "   "}
  226.         append outLine $name
  227.         if {[incr count] < 4} {
  228.             set padLen [expr 17-[clength $name]]
  229.             if {$padLen < 3} {
  230.                set padLen 3}
  231.             append outLine [replicate " " $padLen]
  232.         } else {
  233.            if {![help:Display $outLine]} {
  234.                return}
  235.            set outLine ""
  236.            set count 0
  237.         }
  238.     }
  239.     if {$count != 0} {
  240.         help:Display [string trimright $outLine]}
  241.     return
  242. }
  243.  
  244. #------------------------------------------------------------------------------
  245. # Display help on help, the first occurance of a help page called "help" in
  246. # the help root.
  247.  
  248. proc help:HelpOnHelp {} {
  249.     set helpPage [lindex [help:ConvertPath :help] 0]
  250.     if [lempty $helpPage] {
  251.         error "No help page on help found"
  252.     }
  253.     help:DisplayPage $helpPage
  254. }
  255.  
  256. #------------------------------------------------------------------------------
  257. # Help command.
  258.  
  259. proc help {{what {}}} {
  260.     global TCLENV
  261.  
  262.     set TCLENV(help:lineCnt) 0
  263.  
  264.     # Special case "help help", so we can get it at any level.
  265.  
  266.     if {($what == "help") || ($what == "?")} {
  267.         help:HelpOnHelp
  268.         return
  269.     }
  270.  
  271.     set pathList [help:ConvertPath $what]
  272.     if [file isfile [lindex $pathList 0]] {
  273.         help:DisplayPage [lindex $pathList 0]
  274.         return
  275.     }
  276.  
  277.     help:ListSubject $what $pathList subjects pages
  278.     set relativeDir [help:RelativePath [lindex $pathList 0]]
  279.  
  280.     if {[llength $subjects] != 0} {
  281.         help:Display "\nSubjects available in $relativeDir"
  282.         help:DisplayColumns $subjects
  283.     }
  284.  
  285.     if {[llength $pages] != 0} {
  286.         help:Display "\nHelp pages available in $relativeDir"
  287.         help:DisplayColumns $pages
  288.     }
  289. }
  290.  
  291.  
  292. #------------------------------------------------------------------------------
  293. # helpcd command.  The name of the new current directory is assembled from the
  294. # current directory and the argument.
  295.  
  296. proc helpcd {{dir :}} {
  297.     global TCLENV
  298.  
  299.     set pathName [lindex [help:ConvertPath $dir] 0]
  300.  
  301.     if {![file isdirectory $pathName]} {
  302.         error "Helpcd: \"$dir\" is not a subject"}
  303.  
  304.     set TCLENV(help:curSubject) [help:RelativePath $pathName]
  305.     return
  306. }
  307.  
  308. #------------------------------------------------------------------------------
  309. # Helpcd main.
  310.  
  311. proc helppwd {} {
  312.         global TCLENV
  313.         echo "Current help subject: $TCLENV(help:curSubject)"
  314. }
  315.  
  316. #------------------------------------------------------------------------------
  317. # apropos command.  This search the 
  318.  
  319. proc apropos {regexp} {
  320.     global TCLENV
  321.  
  322.     set TCLENV(help:lineCnt) 0
  323.  
  324.     set ch [scancontext create]
  325.     scanmatch -nocase $ch $regexp {
  326.         set path [lindex $matchInfo(line) 0]
  327.         set desc [lrange $matchInfo(line) 1 end]
  328.         if {![help:Display [format "%s - %s" $path $desc]]} {
  329.             set stop 1
  330.             return
  331.             }
  332.     }
  333.     set stop 0
  334.     foreach dir [help:RootDirs] {
  335.         foreach brief [glob -nocomplain $dir:*.brf] {
  336.             set briefFH [open $brief]
  337.             scanfile $ch $briefFH
  338.             close $briefFH
  339.             if $stop break
  340.         }
  341.         if $stop break
  342.     }
  343.     scancontext delete $ch
  344. }
  345.  
  346. #------------------------------------------------------------------------------
  347. # One time initialization done when the file is sourced.
  348. #
  349. global TCLENV
  350.  
  351. set TCLENV(help:curSubject) ":"
  352.